home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr51 / tag_utes.zip / PRNTTAGS.PRG < prev    next >
Text File  |  1993-04-01  |  5KB  |  133 lines
  1. PROCEDURE PrntTags
  2. *-------------------------------------------------------------------------------
  3. *-- Programmer..: David Love (DAVIDLOVE)
  4. *-- Date........: 01/31/1992
  5. *-- Notes.......: This routine is a "quick and not-so-dirty" method of printing
  6. *--               the tag and key expressions for a dbf's production mdx file.
  7. *--               It obviates the need for DISP/LIST STAT TO PRINT (or DISP STAT
  8. *--               followed by SHIFT+PrtScr).
  9. *--               This code is modified from the procedure RedoTags.prg,
  10. *--               previously posted on the BORBBS.
  11. *--             : The proc will print the full key expression, including
  12. *--               FOR/DESCENDING/UNIQUE options, if present.
  13. *--             : This procedure will create a database file (RedoTags.dbf) and
  14. *--               a text file (RedoTags.txt).  Upon completion, both files will
  15. *--               be erased.  These files are necessary because dBASE IV 1.1
  16. *--               does not have functions that return the FOR/DESCENDING/UNIQUE
  17. *--               options of the index tags.
  18. *-- Written for.: dBASE IV, 1.1
  19. *-- Rev. History:
  20. *-- Calls.......: None
  21. *-- Called by...: Any
  22. *-- Usage.......: do PrntTags with "<cDBF>"
  23. *-- Example.....: do PrntTags with "Referral"
  24. *-- Returns.....: None
  25. *-- Parameters..: cDBF = Name of DATABASE file, no extension necessary.
  26. *-- Acknowledgement..: Bowen Moursund for the code that creates RedoTags.dbf
  27. *--                    (Download PRGCREAT.ZIP for more info.)
  28. *-------------------------------------------------------------------------------
  29.  
  30.     parameter cDBF
  31.     
  32.     use (cDBF)
  33.     
  34.     *-- only perform routine if an index tag exists
  35.     if "" # tag( (cdbf), 1)
  36.       private nTags, nMaxTags, cConsole, cTalk
  37.  
  38.       *-- used to find UNIQUE/DESCENDING/FOR clauses
  39.       cConsole = set("CONSOLE")
  40.       set console off
  41.       if file("RedoTags.txt")
  42.         erase "RedoTags.txt"
  43.       endif
  44.       list stat to file RedoTags.txt
  45.  
  46.       *-- creates a database file, RedoTags.dbf, which has three 254 char fields
  47.       if file("RedoTags.dbf")
  48.         erase "RedoTags.dbf"
  49.       endif
  50.       set printer to file RedoTags.dbf
  51.       set printer on
  52.       ??? "{3}{92}{1}{24}{0}{0}{0}{0}{129}{0}{251}{2}{0}{0}{0}{0}{0}{0}{0}{0}{0}"+;
  53.       "{0}{0}{0}{0}{0}{0}{0}{0}{0}{201}{0}{84}{65}{71}{83}{49}{0}{0}{0}{0}{0}{0}"+;
  54.       "{67}{3}{0}{26}{84}{254}{0}{0}{0}{1}{0}{0}{0}{0}{0}{0}{0}{0}{0}{0}{0}{84}"+;
  55.       "{65}{71}{83}{50}{0}{0}{0}{0}{0}{0}"
  56.       ??? "{67}{1}{1}{26}{84}{254}{0}{0}{0}{1}{0}{0}{0}{0}{0}{0}{0}{0}{0}{0}{0}"+;
  57.       "{84}{65}{71}{83}{51}{0}{0}{0}{0}{0}{0}{67}{255}{1}{26}{84}{254}{0}{0}{0}"+;
  58.       "{1}{0}{0}{0}{0}{0}{0}{0}{0}{0}{0}{0}{13}{26}"
  59.       set printer to
  60.       set printer off
  61.  
  62.       *-- append to RedoTags if the line contains 'TAG:' (no quotes)
  63.       use RedoTags
  64.       append from RedoTags.txt type sdf for "TAG:" $ tags1
  65.       set console &cConsole
  66.  
  67.       *-- figure out how many tags there are
  68.       nMaxTags = reccount()
  69.  
  70.       *-- put any 'for' expression(s) in a separate field
  71.       replace all tags3 with iif( at("For:",tags1) > 0, ;
  72.         substr( tags1, at("For:",tags1) + 5) + " " + trim(tags2),"")
  73.  
  74.       *-- declare an array to hold the info
  75.       declare aTags[nMaxTags,5]
  76.  
  77.       *-- store descending/unique/for info to the array variables
  78.       go top
  79.       nTags = 1
  80.       do while .not. eof()
  81.         store "(Descending)" $ tags1 to aTags[nTags,3]
  82.         store "(Unique)" $ tags1 to aTags[nTags,4]
  83.         store trim( tags3 ) to aTags[nTags,5]
  84.         nTags = nTags + 1
  85.         skip
  86.       enddo
  87.  
  88.       *-- store the key expressions and tags to the array
  89.       use (cDBF)
  90.       nTags = 1
  91.       do while "" # tag( (cDBF),nTags )
  92.         store key( (cDBF),nTags ) to aTags[nTags,1]  && grab the key
  93.         store tag( (cDBF),nTags ) to aTags[nTags,2]  && grab the tagname
  94.         nTags = nTags + 1
  95.       enddo
  96.       use   && don't need the file to be open any more
  97.  
  98.       *-- print each tag with it's key expression
  99.       cTalk = set("talk")
  100.       set talk off
  101.       set printer on
  102.       ?? "DATABASE: "+cDBF at 0
  103.       ?
  104.       ?? "TAG" at 0
  105.       ?? "KEY EXPRESSION" at 12
  106.       ?
  107.       nTags = 1
  108.       do while nTags <= nMaxTags
  109.         ?? aTags[nTags,2] at 0
  110.         ?? aTags[nTags,1] + ;
  111.           iif(aTags[nTags,3]," descending","") + ;
  112.           iif(aTags[nTags,4]," unique","") + ;
  113.           iif(""#trim(aTags[nTags,5])," for "+trim(aTags[nTags,5]),"") at 12
  114.         ?
  115.         nTags = nTags + 1
  116.       enddo
  117.       ?
  118.       set printer off
  119.       set talk &cTalk.
  120.  
  121.       *-- delete the dbf and text files
  122.       erase "RedoTags.dbf"
  123.       erase "RedoTags.txt"
  124.  
  125.       *-- release the array ...
  126.       release aTags
  127.     
  128.     endif  && check for tags ...
  129.     use  && close database
  130.     
  131. RETURN
  132. *-- EoP: RedoTags
  133.